home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / CD CHIP.ISO / WebServ / server7 / bin / ISAPIForum.dpr < prev    next >
Encoding:
Text File  |  1996-07-04  |  3.4 KB  |  155 lines

  1. library ISAPIForum;
  2.  
  3. uses
  4.   Windows,
  5.   SysUtils,
  6.   Classes,
  7.   ISAPISock,
  8.   Httpext,
  9.   Parser;
  10.  
  11. procedure ProcessGet(sock: TISAPISock);
  12. var
  13.   fin: TextFile;
  14.   s: String;
  15. begin
  16.   try
  17.     with sock do
  18.     begin
  19.       // Send a HTML header
  20.       Writeln('HTTP/1.0 200 OK');
  21.       Writeln('Content-type: text/html');
  22.       Writeln('');
  23.  
  24.       // Start of body
  25.       HPageStart;
  26.       HHeading(3, 'Forum Discussion');
  27.  
  28.       // Dump out message database
  29.       AssignFile(fin, ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'ForumMessages.txt');
  30.       try
  31.         Reset(fin);
  32.         try
  33.           while NOT EOF(fin) do
  34.           begin
  35.             Readln(fin, s);
  36.             HLine(s);
  37.           end;
  38.         finally
  39.           CloseFile(fin);
  40.         end;
  41.       except
  42.         // Something bad happened.
  43.       end;
  44.  
  45.       // Add a form so that the reader can add his/her own comments
  46.       HFormStart('POST', '/bin/ISAPIForum.dll');
  47.  
  48.       HSeparator;
  49.       HHeading(3, 'What do you think?');
  50.       HTextArea('Your comments? ', 'UserComment', '', 60, 10);
  51.       HLine('');
  52.       HEditBox('Your Name:  ', 'UserName', '', 50, 50);
  53.       HFormEnd('Submit','Clear');
  54.  
  55.  
  56.       // End the page
  57.       HPageEnd;
  58.     end;
  59.   except
  60.      // Something went wrong
  61.   end;
  62. end;
  63.  
  64. procedure ProcessPost(sock: TISAPISock);
  65. var
  66.   fout: TextFile;
  67.   s: String;
  68. begin
  69.   try
  70.     with sock do
  71.     begin
  72.       // Send a HTML header
  73.       Writeln('HTTP/1.0 200 OK');
  74.       Writeln('Content-type: text/html');
  75.       Writeln('');
  76.  
  77.       // Start of body
  78.       HPageStart;
  79.  
  80.       try
  81.         AssignFile(fout, ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'ForumMessages.txt');
  82.         Append(fout);
  83.         try
  84.           System.Writeln(fout,'****************');
  85.           System.Writeln(fout, EscapeDecode(GetFormVal('UserName'))+' wrote on '+DateTimeToStr( Now ) );
  86.           System.Writeln(fout, EscapeDecode(GetFormVal('UserComment')) );
  87.         finally
  88.           CloseFile(fout);
  89.         end;
  90.       except
  91.         // Something bad happened
  92.         HLine('Something bad has happened');
  93.       end;
  94.  
  95.       HLine('Your comment has been noted! Thanks!');
  96.       HPageEnd;
  97.     end;
  98.   finally
  99.      // Something went wrong
  100.   end;
  101. end;
  102.  
  103. // CASE MATTERS FOR THIS FUNCTION NAME
  104. function GetExtensionVersion(var ver: THSE_VERSION_INFO): Boolean; stdcall;
  105. begin
  106.   result:=True;
  107. end;
  108.  
  109. // CASE MATTERS FOR THIS FUNCTION NAME
  110. function HttpExtensionProc(var ecb: TEXTENSION_CONTROL_BLOCK): LongInt; stdcall;
  111. var
  112.   sock: TISAPISock;
  113.   method: String;
  114. begin
  115.   // Create the socket helper
  116.   sock:=TISAPISock.Create(ecb);
  117.  
  118.   // Was this a GET or POST?
  119.   method:=sock.GetServerVariable('REQUEST_METHOD');
  120.   if method='GET' then
  121.   begin
  122.     ProcessGet(sock)
  123.   end
  124.   else if method='POST' then
  125.   begin
  126.     ProcessPost(sock)
  127.   end
  128.   else
  129.   begin
  130.     // Don't understand this...
  131.     sock.Writeln('HTTP/1.0 200 OK');
  132.     sock.Writeln('Content-type: text/html');
  133.     sock.Writeln('');
  134.     sock.Writeln('I didn''t understand that request');
  135.   end;
  136.  
  137.  
  138.   // Return a normal status code
  139.   StrLCopy( ecb.lpszLogData, PChar('DLL Finished with no errors'), HSE_LOG_BUFFER_LEN-1);
  140.   Result:=HSE_STATUS_SUCCESS;
  141.  
  142.   // Free the socket
  143.   sock.Free;
  144. end;
  145.  
  146. // * REQUIRED FOR DYNAMIC BINDING.
  147. // * Index values aren't need.
  148. // * Case doesn't matter here.
  149. exports
  150.   GetExtensionVersion,
  151.   HttpExtensionProc;
  152.  
  153. begin
  154. end.
  155.